unit LogData;

interface

uses SysUtils, Classes;

type
  TVarType = record
    Id: string;
    Len: Integer;
    Code: Integer;
    ErrorCode: Integer;
  end;

procedure AddOption(const Id, Value, Lang: string);
procedure AddTypedef(const Id: string);
procedure AddField(const Id: string; const VarType: TVarType; Indexed: Boolean);

procedure VerifyType(var VarType: TVarType);

type
  TElement = class
    Line: Integer;
    Id: string;
    constructor Create(const ArgId: string; Implicit: Boolean = False);
  end;

  TOption = class(TElement)
    Value: string;
    Lang: string;
    constructor Create(const ArgId, ArgValue: string; const ArgLang: string = '');
  end;

  TTypedef = class(TElement)
    FieldList: TList;
    MethodList: TList;
    constructor Create(const ArgId: string);
    destructor Destroy(); override;
  end;

  TMethodArg = class(TElement)
    VarType: TVarType;
    constructor Create(const ArgId: string; const ArgVarType: TVarType; Implicit: Boolean);
  end;

  TMethod = class(TElement)
    OutputDefinition: string;
    ArgumentList: TList;
    constructor CreateDefault(Typedef: TTypedef);
    destructor Destroy(); override;
  end;

  TField = class(TElement)
    VarType: TVarType;
    Indexed: Boolean;
    constructor Create(const ArgId: string; ArgVarType: TVarType; ArgIndexed: Boolean);
  end;

var
  OptionList: TList;
  TypedefList: TList;

const
  FIELD_ERROR = 0;
  FIELD_INTEGER = 1;
  FIELD_STRING = 2;
  FIELD_REAL = 3;
  FIELD_GUID = 4;
  FIELD_BINARY = 5;
  FIELD_DATETIME = 16;
  FIELD_DATE = 17;
  FIELD_TIME = 18;

  FIXED_LEN_FIELDS = [FIELD_INTEGER, FIELD_REAL, FIELD_GUID, FIELD_DATETIME, FIELD_DATE, FIELD_TIME];

implementation

uses MuUtils, LogLexer, LogErrors;

constructor TElement.Create(const ArgId: string; Implicit: Boolean);
begin
  Id := ArgId;
  Line := Iif(Implicit, 0, LogLexer.Line);
end;

constructor TOption.Create(const ArgId, ArgValue, ArgLang: string);
begin
  inherited Create(ArgId);
  Value := ArgValue;
  Lang := ArgLang;
end;

procedure AddOption(const Id, Value, Lang: string);
var
  LangStr: string;
begin
  LangStr := Iif(Lang <> '', '(' + Lang + ')', '');
  OptionList.Add(TOption.Create(Id, Value, Lang));
  WriteLn('OPTION ', Id, ' ', LangStr, ' WAS ADDED in line ', LogLexer.Line, ' VALUE=', Value);
end;

constructor TTypedef.Create(const ArgId: string);
begin
  inherited Create(ArgId);
  FieldList := TList.Create();
  MethodList := TList.Create();
end;

destructor TTypedef.Destroy();
begin
  FreeObjectList(FieldList);
  FreeObjectList(MethodList);
  inherited Destroy();
end;

procedure AddTypedef(const Id: string);
begin
  TypedefList.Add(TTypedef.Create(Id));
  WriteLn('TYPE ', Id, ' WAS ADDED in line ', LogLexer.Line);
end;

constructor TField.Create(const ArgId: string; ArgVarType: TVarType; ArgIndexed: Boolean);
begin
  inherited Create(ArgId);
  VarType := ArgVarType;
  Indexed := ArgIndexed;
end;

procedure AddField(const Id: string; const VarType: TVarType; Indexed: Boolean);
var
  LastType: TTypedef;
begin
  if TypedefList.Count = 0 then InternalError('Type list is empty, but field is adding.');
  Pointer(LastType) := TypedefList[TypedefList.Count - 1];
  LastType.FieldList.Add(TField.Create(Id, VarType, Indexed));
  WriteLn('FIELD ', Id, ' WAS ADDED in line ', LogLexer.Line, ' TYPE = ', VarType.Id, '; LEN = ', VarType.Len, ';', Iif(Indexed, ' INDEXED', ''));
end;

constructor TMethodArg.Create(const ArgId: string; const ArgVarType: TVarType; Implicit: Boolean);
begin
  inherited Create(ArgId, Implicit);
  VarType := ArgVarType;
end;

constructor TMethod.CreateDefault(Typedef: TTypedef);
var
  I: Integer;
  Field: TField;
begin
  inherited Create('', True);
  ArgumentList := TList.Create();
  for I := 0 to Typedef.FieldList.Count - 1 do
  begin
    Field := Typedef.FieldList[I];
    ArgumentList.Add(TMethodArg.Create(Field.Id, Field.VarType, True));
  end;
  Typedef.MethodList.Add(Self);
end;

destructor TMethod.Destroy();
begin
  FreeObjectList(ArgumentList);
  inherited Destroy();
end;

procedure VerifyType(var VarType: TVarType);

  procedure VerifyIntType();
  begin
    VarType.Code := FIELD_INTEGER;
    if VarType.Len = -1 then VarType.Len := 4;
    if VarType.Len = 1 then Exit;
    if VarType.Len = 2 then Exit;
    if VarType.Len = 4 then Exit;
    if VarType.Len = 8 then Exit;
    VarType.ErrorCode := ERROR_TYPE_UNSUPPORTED_INT_SIZE;
  end;

  procedure VerifyStringType();
  begin
    VarType.Code := FIELD_STRING;
    if VarType.Len = -1 then VarType.Len := 255;
  end;

  procedure VerifyFloatType();
  begin
    VarType.Code := FIELD_REAL;

    if VarType.Len <> -1 then
    begin
      VarType.ErrorCode := ERROR_TYPE_FOR_FLOATS_NO_SIZE;
      Exit;
    end;

    if VarType.Id = 'Single' then VarType.Len := 4;
    if VarType.Id = 'Double' then VarType.Len := 8;
    if VarType.Id = 'Extended' then VarType.Len := 10;
  end;

  procedure VerifyDatetimeType();
  begin
    if VarType.Id = 'Datetime' then VarType.Code := FIELD_DATETIME;
    if VarType.Id = 'Date' then VarType.Len := FIELD_DATE;
    if VarType.Id = 'Time' then VarType.Len := FIELD_TIME;

    if VarType.Len <> -1 then
    begin
      VarType.ErrorCode := ERROR_TYPE_FOR_DATES_NO_SIZE;
      Exit;
    end;

    VarType.Len := SizeOf(TDateTime);
  end;

  procedure VerifyGuidType();
  begin
    VarType.Code := FIELD_GUID;

    if VarType.Len <> -1 then
    begin
      VarType.ErrorCode := ERROR_TYPE_FOR_GUID_NO_SIZE;
      Exit;
    end;

    VarType.Len := 0;
  end;

  procedure VerifyBinaryType();
  begin
    if VarType.Len = -1 then VarType.Len := 0;
    VarType.Code := FIELD_BINARY;
  end;

begin
  VarType.Code := 0;
  VarType.ErrorCode := 0;

  if (VarType.Id = 'Int') or (VarType.Id = 'Integer') then VerifyIntType() else
  if (VarType.Id = 'String') then VerifyStringType() else
  if (VarType.Id = 'Single') or (VarType.Id = 'Double') or (VarType.Id = 'Extended') then VerifyFloatType() else
  if (VarType.Id = 'Date') or (VarType.Id = 'Time') or (VarType.Id = 'Datetime') then VerifyDateTimeType() else
  if (VarType.Id = 'Guid') then VerifyGuidType() else
  if (VarType.Id = 'Binary') then VerifyBinaryType() else
    VarType.ErrorCode := ERROR_TYPE_UNKNOWN;
end;



initialization
  OptionList := TList.Create();
  TypedefList := TList.Create();

finalization
  FreeObjectList(OptionList);
  FreeObjectList(TypedefList);

end.